home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0003_OOP Line Editor.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  6KB  |  232 lines
  1.  
  2. { A good line editor object }
  3.  
  4. UNIT EditObj; {  Object_Line_Editor  }
  5.  
  6. INTERFACE
  7.  
  8. USES Crt, KeyBd;
  9.  
  10. TYPE
  11.   LineEdit = OBJECT
  12.     Pos, XPos, YPos : Integer;
  13.     EdLine : String;
  14.     PROCEDURE InitEdit( X, Y: Integer; LineIn: String );
  15.     FUNCTION  GetLine: String;
  16.   END;
  17.  
  18. VAR
  19.    Kbd: KeyBoard;   {<<<========== Global definition of OBJECT}
  20.  
  21. {***************************************************************}
  22.                         IMPLEMENTATION
  23. {***************************************************************}
  24.  
  25. {-------------------------------------------------
  26. - Name   : InitEdit                              -
  27. - Purpose: Set up editor, display line onscreen  -
  28. -------------------------------------------------}
  29.  
  30. PROCEDURE LineEdit.InitEdit;
  31.   BEGIN
  32.     EdLine := LineIn;
  33.     Pos  := Ord( LineIn[0] ) + 1;
  34.     XPos := X;
  35.     YPos := Y;
  36.     GotoXY( X, Y );
  37.     Write( LineIn );
  38.   END;
  39.  
  40. {-------------------------------------------------
  41. - Name   : GetLine                               -
  42. - Purpose: Process keying from user              -
  43. -          Maximum 80 characters accepted        -
  44. -------------------------------------------------}
  45.  
  46. FUNCTION  LineEdit.GetLine;
  47.   VAR
  48.     KeyFlags : Byte;
  49.     Ch: Char;
  50.     FunctKey, Finish: Boolean;
  51.   BEGIN
  52.     Finish := FALSE;
  53.     REPEAT
  54.       IF Kbd.GetKey( KeyFlags, FunctKey, Ch ) THEN BEGIN
  55.         IF FunctKey THEN
  56.           CASE Ch OF
  57. { HOME   }  #$47: Pos := 1;
  58. { END    }  #$4F: Pos := Ord( EdLine[0] ) + 1;
  59. { RIGHT  }  #$4D: BEGIN
  60.                     IF Pos < 80 THEN Inc( Pos );
  61.                     IF Pos > Ord( EdLine[0] ) THEN
  62.                       Insert( ' ', EdLine, Pos );
  63.                     END;
  64. { LEFT   }  #$4B: IF Pos > 1  THEN Dec( Pos );
  65. { DELETE }  #$53: IF Pos <= Ord( EdLine[0] ) THEN
  66.                      Delete( EdLine, Pos, 1 );
  67.             END {CASE Ch}
  68.           ELSE {IF}
  69.             CASE Ch OF
  70. { BS }        #$08: IF Pos > 1 THEN BEGIN
  71.                       Delete( EdLine, Pos-1, 1 );
  72.                       Dec( Pos );
  73.                       END;
  74. { ENTER }     #$0D: Finish := TRUE;
  75.               ELSE BEGIN
  76.                 IF( ( KeyFlags AND $80 ) <> $80 )
  77.                    THEN Insert( Ch, EdLine, Pos )
  78.                    ELSE EdLine[Pos] := Ch;
  79.                 IF Pos > Ord( EdLine[0] ) THEN
  80.                    EdLine[0] := Chr( Pos );
  81.                 IF Pos < 80 THEN Inc( Pos );
  82.                 END     {CASE CH ELSE}
  83.               END;    {CASE Ch}
  84.         GotoXY( XPos, YPos );
  85.         Write( EdLine, ' ' );
  86.         GotoXY( XPos+Pos-1, YPos );
  87.         END;  {IF Kbd.GetKey}
  88.       UNTIL Finish;
  89.       GetLine := EdLine;
  90.     END;
  91.  
  92. END.
  93.  
  94.  
  95. {  KEYBOARD UNIT }
  96. UNIT Keybd;  { Keybd.PAS / Keybd.TPU }
  97.  
  98. INTERFACE
  99.  
  100. USES Crt, Dos;
  101.  
  102. TYPE
  103.   CType = ( UBAR, BLOCK );
  104.   Keyboard = OBJECT
  105.     ThisCursor: CType;
  106.     PROCEDURE InitKeyBd;
  107.     PROCEDURE SetCursor( Cursor: CType );
  108.     FUNCTION  GetCursor: CType;
  109.     FUNCTION  GetKbdFlags: Byte;
  110.     FUNCTION  GetKey( VAR KeyFlags: Byte; VAR FunctKey: Boolean;
  111.                                         VAR Ch: Char ): Boolean;
  112.   END;
  113.  
  114. {***************************************************************}
  115.                       IMPLEMENTATION
  116. {***************************************************************}
  117.  
  118.  
  119. {Keyboard}
  120.  
  121. {-------------------------------------------------
  122. - Name   : InitKeyBd                             -
  123. - Purpose: Set the cursor to underline style     -
  124. -          and empty keyboard buffer             -
  125. -------------------------------------------------}
  126.  
  127. PROCEDURE Keyboard.InitKeyBd;
  128.   VAR
  129.     Ch : Char;
  130.   BEGIN
  131.     SetCursor( UBAR );
  132.     WHILE( KeyPressed ) DO Ch := ReadKey;
  133.   END;
  134.  
  135. {-------------------------------------------------
  136. - Name   : SetCursor                             -
  137. - Purpose: Modify number of lines for cursor     -
  138. -------------------------------------------------}
  139.  
  140. PROCEDURE Keyboard.SetCursor;
  141.   VAR
  142.     Regs: Registers;
  143.   BEGIN
  144.     CASE Cursor OF
  145.       UBAR:  Regs.Ch := 6;
  146.       BLOCK: Regs.Ch := 1;
  147.     END;
  148.     Regs.CL := 7;
  149.     Regs.AH := 1;
  150.     Intr( $10, Regs );
  151.   END;
  152.  
  153. {-------------------------------------------------
  154. - Name   : GetKbdFlags                           -
  155. - Purpose: Monitor the Insert key                -
  156. - Output : Shift key status flag byte            -
  157. -------------------------------------------------}
  158.  
  159. FUNCTION  Keyboard.GetKbdFlags: Byte;
  160.   VAR
  161.     Regs: Registers;
  162.   BEGIN
  163.     (* FOR enhanced keyboards: AH := $12 *)
  164.     (* FOR normal keyboards:   AH := $02 *)
  165.     Regs.AH := $12;
  166.     Intr( $16, Regs );
  167.     IF( Regs.AX AND $80 = $80 ) THEN SetCursor( BLOCK )
  168.                                 ELSE SetCursor( UBAR );
  169.     GetKbdFlags := Regs.AX;
  170.   END;
  171.  
  172. {-------------------------------------------------
  173. - Name   : GetCursor                             -
  174. - Purpose: Query current cursor state            -
  175. -------------------------------------------------}
  176.  
  177. FUNCTION  Keyboard.GetCursor;
  178.   BEGIN
  179.     GetCursor := ThisCursor;
  180.   END;
  181.  
  182. {-------------------------------------------------
  183. - Name   : GetKey                                -
  184. - Purpose: Get a keypress contents if any        -
  185. -          Updates a function keypressed flag    -
  186. -------------------------------------------------}
  187.  
  188. FUNCTION  Keyboard.GetKey;
  189.   VAR
  190.     Result : Boolean;
  191.   BEGIN
  192.     Result := KeyPressed;
  193.     FunctKey := FALSE;
  194.     Ch := #$00;       {Use this to check for Function key press}
  195.     IF Result THEN BEGIN
  196.       Ch := ReadKey;
  197.       IF( KeyPressed AND ( Ch = #$00 ) ) THEN BEGIN
  198.         Ch := ReadKey;
  199.         FunctKey := TRUE;
  200.         END;
  201.       END;
  202.     KeyFlags := GetKbdFlags;
  203.     GetKey := Result;
  204.     END;
  205.  
  206. END.
  207.  
  208. {   DEMO PROGRAM  }
  209.  
  210. PROGRAM EditDemo;
  211.  
  212. {-------------------------------------------------
  213. -  Show off example of global object use         -
  214. -------------------------------------------------}
  215.  
  216. USES Crt, EditObj;
  217.  
  218. VAR
  219.    Editor: LineEdit;           {Instantiation of LineEdit OBJECT}
  220.    ResultStr: String;
  221. BEGIN
  222.    ClrScr;
  223.    WITH Editor DO
  224.    BEGIN
  225.       InitEdit( 1, 10, 'Edit this sample line');
  226.       ResultStr := GetLine;
  227.       GotoXY( 1, 15 );
  228.       WriteLn( ResultStr );
  229.    END;
  230.    ReadLn;
  231. END.
  232.